home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / libr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  48.0 KB  |  1,641 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* libr - procedures for reading (in C format) ais and tre files*/
  10.  
  11. #include "hdr.h"
  12. #include "vars.h"
  13. #include "libhdr.h"
  14. #include "ifile.h"
  15. #include "dbxprots.h"
  16. #include "chapprots.h"
  17. #include "arithprots.h"
  18. #include "dclmapprots.h"
  19. #include "miscprots.h"
  20. #include "smiscprots.h"
  21. #include "setprots.h"
  22. #include "libfprots.h"
  23. #include "libprots.h"
  24. #include "librprots.h"
  25.  
  26. static void getlitmap(IFILE *, Symbol);
  27. static char *getmisc(IFILE *, Symbol, int);
  28. static void getrepr(IFILE * , Symbol);
  29. static void getnod(IFILE *, char *, Node, int);
  30. static void getnval(IFILE *, Node);
  31. static int *getuint(IFILE *, char *);
  32. static void getovl(IFILE *, Symbol);
  33. static void getsig(IFILE *, Symbol, int);
  34. static void getudecl(IFILE *, int);
  35. static Tuple add_tree_node(Tuple, Node);
  36. static void retrieve_tree_nodes(IFILE *, int, Tuple);
  37.  
  38. extern IFILE *TREFILE, *AISFILE, *STUBFILE, *LIBFILE;
  39.  
  40. Declaredmap getdcl(IFILE *ifile)            /*;getdcl*/
  41. {
  42.     Declaredmap d;
  43.     char    *id;
  44.     Symbol    sym;
  45.     int n = 0, vis, i;
  46.  
  47.     n = getnum(ifile, "dcl_is_map_defined");
  48.     if (n == 0) {
  49. #ifdef IOT
  50.         if (ifile->fh_trace == 1) printf("dcl - map undefined\n");
  51. #endif
  52.         return (Declaredmap) 0;
  53.     }
  54.     n = getnum(ifile, "dcl-number-defined"); /* get item count */
  55.     d = dcl_new(n);
  56. #ifdef IOT
  57.     if (ifile->fh_trace == 1) printf("getdcl %d\n", n);
  58. #endif
  59.     if (n == 0) return d;
  60.     for (i = 1; i <= n; i++) {
  61.         id = getstr(ifile, "sym-str");
  62.         sym = getsymref(ifile, "");
  63.         vis = getnum(ifile, "sym-vis");
  64.         dcl_put_vis(d, id, sym, vis);
  65. #ifdef IOT
  66.         if (ifile->fh_trace == 1)
  67.             printf("  %s s%du%d %d\n", id, S_SEQ(sym), S_UNIT(sym), vis);
  68. #endif
  69.     }
  70.     return(d);
  71. }
  72.  
  73. static void getlitmap(IFILE *ifile, Symbol sym)                /*;gettlitmap*/
  74. /* called for na_enum to input literal map.
  75.  * The literal map is a tuple, entries consisting of string followed
  76.  * by integer.
  77.  */
  78. {
  79.     Tuple    tup;
  80.     int i, n;
  81.  
  82.     n = getnum(ifile, "litmap-n");
  83.     tup = tup_new(n);
  84.     for (i = 1; i <= n; i+=2) {
  85.         tup[i] = getstr(ifile, "litmap-str");
  86.         tup[i+1] = (char *) getnum(ifile, "litmap-value");
  87.     }
  88.     OVERLOADS(sym) = (Set) tup;
  89. }
  90.  
  91. static char *getmisc(IFILE *ifile, Symbol sym, int mval)            /*;getmisc*/
  92. {
  93.     /* read MISC information if present 
  94.  * MISC is integer except for package, in which case it is a triple.
  95.  * The first two components are integers, the last is  a tuple of
  96.  * symbols
  97.  */
  98.     int    nat, i, n;
  99.     Tuple  tup, stup;
  100.  
  101.     nat = NATURE(sym);
  102.     if ((nat == na_package || nat == na_package_spec)) {
  103.         if (mval) {
  104.             tup = tup_new(3);
  105.             tup[1] = (char *) getnum(ifile, "misc-package-1");
  106.             tup[2] = (char *) getnum(ifile, "misc-package-2");
  107.             n = getnum(ifile, "misc-package-tupsize");
  108.             stup = tup_new(n);
  109.             for (i = 1; i<= n; i++)
  110.                 stup[i] = (char *) getsymref(ifile, "misc-package-symref");
  111.             tup[3] = (char *) stup;
  112.             return (char *) tup;
  113.         }
  114.         else {
  115.             getnum(ifile, "misc");
  116.             return  (char *)MISC(sym);
  117.         }
  118.     }
  119.     else if ((nat == na_procedure || nat == na_function) && mval) {
  120.         tup = tup_new(2);
  121.         tup[1] = (char *) getnum(ifile, "misc-number");
  122.         tup[2] = (char *) getsymref(ifile, "misc-symref");
  123.         return (char *) tup;
  124.     }
  125.     else {
  126.         return  (char *)getnum(ifile, "misc");
  127.     }
  128. }
  129. static void getrepr(IFILE * ifile, Symbol sym)            /*;getrepr*/
  130. {
  131.     /* read int representation information if present */
  132.  
  133.     int     repr_tag, i, n;
  134.     Tuple     align_mod_tup,align_tup,repr_tup;
  135.     Tuple     tup4;
  136.  
  137.     repr_tag = getnum(ifile, "repr-type");
  138.     if (repr_tag != -1) {
  139.             if (repr_tag == TAG_RECORD)     { /* record type */
  140.                 repr_tup = tup_new(4);
  141.                 repr_tup[1] = (char *) TAG_RECORD;
  142.                    repr_tup[2] = (char *) getnum(ifile,"repr-rec-size");
  143.                 align_mod_tup = tup_new(2);
  144.                 align_mod_tup[1] = (char *) getnum(ifile,"repr-rec-mod");
  145.                 n = getnum(ifile,"repr-align_tup_size");
  146.                 align_tup = tup_new(0);
  147.                 for (i=1; i<=n; i++) {
  148.                     tup4 = tup_new(4);
  149.                     tup4[1] = (char *) getsymref(ifile,"repr-rec-align-1");
  150.                     tup4[2] = (char *) getnum(ifile,"repr-rec-align-2");
  151.                     tup4[3] = (char *) getnum(ifile,"repr-rec-align-3");
  152.                     tup4[4] = (char *) getnum(ifile,"repr-rec-align-4");
  153.                     align_tup = tup_with(align_tup, (char *) tup4);
  154.                 }
  155.                 align_mod_tup[2] = (char *) align_tup;
  156.                    repr_tup[4] = (char *) align_mod_tup;
  157.                 REPR(sym) = repr_tup;
  158.             }
  159.             else if (repr_tag == TAG_ACCESS || 
  160.                      repr_tag == TAG_TASK) { /* access or task type */
  161.                 repr_tup = tup_new(3);
  162.                 repr_tup[1] = (char *) repr_tag;
  163.                  repr_tup[2] = (char *) getnum(ifile, "repr-size-2");
  164.                 repr_tup[3] = (char *) getnodref(ifile, "repr-storage-size");
  165.                 REPR(sym) = repr_tup;
  166.             }
  167.             else {         /* non-record, non-access, non-task type */
  168.                 n = getnum(ifile, "repr-tup-size");
  169.                 repr_tup = tup_new(n);
  170.                 repr_tup[1] = (char *) repr_tag;
  171.                 for (i=2; i <= n; i++)
  172.                     repr_tup[i] = (char *) getnum(ifile, "repr-info");
  173.                 REPR(sym) = repr_tup;
  174.             }
  175.     }
  176. }
  177.  
  178.  
  179. static void getnod(IFILE *ifile, char *desc, Node node, int unum)    /*;getnod*/
  180. {
  181.     /* 
  182.      * Read information for the node from a file (ifile)
  183.      * Since all the nodes in the tree all have the same N_UNIT value, 
  184.      * the node can be read from the file in a more compact format.
  185.      * The N_UNIT of the node itself and of its children (N_AST1...) need not
  186.      * be read only their N_SEQ filed needs to be read. There is one 
  187.      * complication of this scheme. OPT_NODE which is (seq=1, unit=0) will
  188.      * conflict with (seq=1,unit=X)  of current unit. Therefore, in this case a 
  189.      * sequence # of -1 will signify OPT_NODE.
  190.      */
  191.     int i;
  192.     short    nk, num1, num2, has_n_list;
  193.     Tuple    ltup;
  194.     short    fnum[24], fnums, fnumr=0;
  195.  
  196.     /* copy standard info */
  197.     fnums = getnum(ifile, desc);
  198. #ifdef HI_LEVEL_IO
  199.     /*fread((char *) &fnums, sizeof(short), 1, ifile->fh_file);*/
  200.     fread((char *) fnum,  sizeof(short), fnums, ifile->fh_file);
  201. #else
  202.     /*read(ifile->fh_file, (char *) &fnums, sizeof(short));*/
  203.     read(ifile->fh_file, (char *) fnum, sizeof(short) * fnums);
  204. #endif
  205.     if (fnums == 0) {
  206.         chaos("getnod-fnums-zero");
  207.     }
  208.     fnumr = 0;
  209.     nk = fnum[fnumr++];
  210.     N_KIND(node) = nk;
  211.     N_SEQ(node) = fnum[fnumr++];
  212.     N_UNIT(node) = unum;
  213. #ifdef DEBUG
  214.     if (trapns>0 && N_SEQ(node)== trapns && N_UNIT(node) == trapnu) trapn(node);
  215. #endif
  216.  
  217.     N_SPAN0(node) = N_SPAN1(node) = 0;
  218.  
  219.     if (N_LIST_DEFINED(nk)) {
  220.         has_n_list = fnum[fnumr++];
  221.         ltup = (has_n_list) ? tup_new(has_n_list - 1) : (Tuple) 0;
  222.     }
  223.     else {
  224.         has_n_list = 0;
  225.     }
  226.     /* ast fields */
  227.     /* See comment above for description of compact format of node */
  228.     N_AST1(node) = N_AST2(node) = N_AST3(node) = N_AST4(node) = (Node)0;
  229.     if (N_AST1_DEFINED(nk)) {
  230.         num1 = fnum[fnumr++];
  231.         N_AST1(node) = (num1 == -1) ? OPT_NODE : getnodptr(num1, unum);
  232.     }
  233.     if (N_AST2_DEFINED(nk)) {
  234.         num1 = fnum[fnumr++];
  235.         N_AST2(node) = (num1 == -1) ? OPT_NODE : getnodptr(num1, unum);
  236.     }
  237.     if (N_AST3_DEFINED(nk)) {
  238.         num1 = fnum[fnumr++];
  239.         N_AST3(node) = (num1 == -1) ? OPT_NODE : getnodptr(num1, unum);
  240.     }
  241.     if (N_AST4_DEFINED(nk)) {
  242.         num1 = fnum[fnumr++];
  243.         N_AST4(node) = (num1 == -1) ? OPT_NODE : getnodptr(num1, unum);
  244.     }
  245.  
  246.     if (N_UNQ_DEFINED(nk)) {
  247.         num1 = fnum[fnumr++]; 
  248.         num2 = fnum[fnumr++];
  249.         if (num1>0 || num2>0)
  250.             N_UNQ(node) = getsymptr(num1, num2);
  251.     }
  252.     if (N_TYPE_DEFINED(nk)) {
  253.         num1 = fnum[fnumr++]; 
  254.         num2 = fnum[fnumr++];
  255.         if (num1>0 || num2>0) {
  256.             N_TYPE(node) = getsymptr(num1, num2);
  257.         }
  258.     }
  259.  
  260. #ifdef IOT
  261.     if (ifile->fh_trace == 2)
  262.         libnodt(ifile, node, fnums, has_n_list);
  263. #endif
  264.  
  265.     /* read out n_list if needed */
  266.     if (has_n_list > 0) {
  267.         for (i = 1; i<has_n_list; i++) {
  268.             ltup[i] = (char *) getnodref(ifile, "n-list-nodref");
  269.         }
  270.         if (ltup != (Tuple)0) {
  271.             N_LIST(node) = ltup;
  272.         }
  273.     }
  274.     if (N_VAL_DEFINED(nk))
  275.         getnval(ifile, node);
  276. }
  277.  
  278. Node getnodref(IFILE *ifile, char *desc)            /*;getnodref*/
  279. {
  280.     Node    node;
  281.     int    seq, unit;
  282.  
  283.     /* 
  284.      * OPT_NODE is node in unit 0 with sequence 1, and needs
  285.      * no special handling here
  286.      */
  287. #ifdef IOT
  288.     if (ifile->fh_trace == 1) {
  289.         printf("%s ", desc);
  290.     }
  291. #endif
  292.     seq = getnum(ifile, "nref-seq");
  293.     unit = getnum(ifile, "nref-unt");
  294.     if (seq == 1 && unit == 0) {
  295.         return OPT_NODE;
  296.     }
  297.     else {
  298.         node = getnodptr(seq, unit);
  299. #ifdef DEBUG
  300.         if (trapns>0 && trapns == seq && trapnu == unit) trapn(node);
  301. #endif
  302.     }
  303.     return node;
  304. }
  305.  
  306. static void getnval(IFILE *ifile, Node node)                /*;getnval*/
  307. {
  308.     /* read N_VAL field for node to AISFILE */
  309.     int        nk, ck;
  310.     Const    con;
  311.     char    *nv;
  312.     Tuple    tup;
  313.     int        i, n, *rn, *rd;
  314.     double    doub;
  315.     Symbolmap   smap;
  316.     Symbol    s1, s2;
  317.  
  318.     nv = NULL;       /* gs nov 1: added to avoid setting N_VAL incorrectly
  319.                         at end of this routine */
  320.     switch (nk = N_KIND(node)) {
  321.       case    as_simple_name:
  322.       case    as_int_literal:
  323.       case    as_real_literal:
  324.       case    as_string_literal:
  325.       case    as_character_literal:
  326.       case    as_subprogram_stub_tr:
  327.       case    as_package_stub:
  328.       case    as_task_stub:
  329.                 nv = (char *) getstr(ifile, "nval-name");
  330.                 break;
  331.       case    as_line_no:
  332.       case    as_number:
  333.       case    as_predef:
  334.                 nv = (char *) getnum(ifile, "nval-int");
  335.                 break;
  336.       case    as_mode:
  337.                 /* convert mode, indeed, the inverse of change made in astread*/
  338.                 nv = (char *) getnum(ifile, "nval-mode");
  339.                 break;
  340.       case    as_ivalue:
  341.                 ck = getnum(ifile, "nval-const-kind");
  342.                 con = const_new(ck);
  343.                 nv = (char *) con;
  344.                 switch (ck) {
  345.                   case    CONST_INT:
  346.                     con->const_value.const_int =
  347.                       getint(ifile, "nval-const-int-value");
  348.                     break;
  349.                   case    CONST_REAL:
  350. #ifdef HI_LEVEL_IO
  351.                     fread((char *) &doub, sizeof(double), 1, ifile->fh_file);
  352. #else
  353.                     read(ifile->fh_file, (char *) &doub, sizeof(double));
  354. #endif
  355.                     con->const_value.const_real = doub;
  356.                     break;
  357.                   case    CONST_UINT:
  358.                     con->const_value.const_uint =
  359.                       getuint(ifile, "nval-const-uint");
  360.                     break;
  361.                   case    CONST_OM:
  362.                     break; /* no further data needed if OM */
  363.                   case    CONST_RAT:
  364.                     rn = getuint(ifile, "nval-const-rat-num");
  365.                     rd = getuint(ifile, "nval-const-rat-den");
  366.                     con->const_value.const_rat = rat_fri(rn, rd);
  367.                     break;
  368.                   case    CONST_CONSTRAINT_ERROR:
  369.                     break;
  370.                 };
  371.                 break;
  372.       case    as_terminate_alt:
  373.                 /*: terminate_statement (9)  nval is depth_count (int)*/
  374.                 nv = (char *) getnum(ifile, "nval-terminate-depth");
  375.                 break;
  376.       case    as_string_ivalue:
  377.                 /* nval is tuple of integers */
  378.                 n = getnum(ifile, "nval-string-ivalue-size");
  379.                 tup     = tup_new(n);
  380.                 for (i = 1;i <= n; i++)
  381.                     tup[i] = (char *)getchr(ifile, "nval-string-ivalue");
  382.                 nv = (char *) tup;
  383.                 break;
  384.       case    as_instance_tuple:
  385.                 n = getnum(ifile, "nval-instance-size");
  386.                 if (n != 0) {
  387.                     if (n != 2)
  388.                         chaos("getnval: bad nval for instantiation");
  389.                     tup = tup_new(n);
  390.                     /* first component is instance map */
  391.                     n = getnum(ifile, "nval-symbolmap-size");
  392.                     smap = symbolmap_new();
  393.                     for (i = 1; i <= n/2; i++) {
  394.                         s1 = getsymref(ifile, "symbolmap-1");
  395.                         s2 = getsymref(ifile, "symbolmap-2");
  396.                         symbolmap_put(smap, s1, s2);
  397.                     }
  398.                     tup[1] = (char *)smap;
  399.                     /* second component is needs_body flag */
  400.                     tup [2] = (char *)getnum(ifile, "nval-flag");
  401.                     nv = (char *)tup;
  402.                 }
  403.                 else nv = NULL;
  404.                 break;
  405.     };
  406.  
  407.     if (N_VAL_DEFINED(nk)) N_VAL(node) = nv;
  408.     if (N_VAL_DEFINED(nk) == FALSE && nv != NULL) {
  409.         chaos("libr.c: nval exists, but N_VAL_DEFINED not");
  410.     }
  411.  
  412.     /* need to handle following cases:
  413. as_simple_name:
  414.     otherwise    identifier string
  415.  
  416.     procedure package_instance (12)
  417.       this procedure builds a node of type as_simple_name
  418.       with N_VAL a symbol pointeger.
  419. as_pragma??
  420. as_array aggregate
  421. as_generic: (cf. 12)
  422.  
  423.  */
  424.  
  425. }
  426.  
  427. static int *getuint(IFILE *ifile, char *desc)                /*;getuint*/
  428. {
  429.     int n, *res;
  430. #ifdef IOT
  431.     int i;
  432.  
  433.     n = getnum(ifile, "uint-size");
  434.     res = (int *) ecalloct((unsigned)n+1, sizeof(int), "getuint");
  435. #ifdef HI_LEVEL_IO
  436.     fread((char *) res, sizeof(int), n+1, ifile->fh_file);
  437. #else
  438.     read(ifile->fh_file, (char *) res, sizeof(int)*(n+1));
  439. #endif
  440.     if (ifile->fh_trace<2) return res;
  441.     for (i = 1;i <= n; i++)
  442.         printf("uint-word %d %d\n", i, res[i]);
  443. #else
  444.     n = getnum(ifile, "uint-size");
  445.     res = (int *) ecalloct((unsigned)n+1, sizeof(int), "getuint");
  446. #ifdef HI_LEVEL_IO
  447.     fread((char *) res, sizeof(int), n+1, ifile->fh_file);
  448. #else
  449.     read(ifile->fh_file, (char *) res, sizeof(int)*(n+1));
  450. #endif
  451. #endif
  452.     return res;
  453. }
  454.  
  455. static void getovl(IFILE *ifile, Symbol sym)                /*;getovl*/
  456. {
  457.     int        nat, n, i;
  458.     Set        ovl;
  459.     Private_declarations    pd;
  460.     Tuple    tup;
  461.  
  462.     nat = NATURE(sym);
  463.     ovl = (Set) 0;
  464.     /* 
  465.      * It is the private declarations for na_package and na_package_spec,
  466.      * and na_generic_package_spec.
  467.      * Otherwise it is a set of symbols:
  468.      *    na_aggregate  na_entry    na_function  na_function_spec
  469.      *    na_literal  na_op  na_procedure     na_procedure_spec
  470.      * It is literal map for enumeration type (na_enum).
  471.      */
  472.     if(nat == na_enum) {
  473.         getlitmap(ifile, sym);
  474.         return;
  475.     }
  476.     else if (nat == na_package || nat == na_package_spec
  477.       || nat == na_generic_package_spec || nat == na_generic_package
  478.       || nat == na_task_type || nat == na_task_obj) {
  479.         /* read in private declarations (rebuild tuple) */
  480.         n = getnum(ifile, "ovl-private-decls-size");
  481.         pd = private_decls_new(n);
  482.         tup = tup_new(n+n);
  483.         for (i = 1; i <= n; i++) {
  484.             tup[2*i-1] =  (char *) getsym(ifile, "ovl-pdecl-1-sym");
  485.             tup[2*i] =  (char *) getsym(ifile, "ovl-pdecl-2-sym");
  486.         }
  487.         pd->private_declarations_tuple = tup;
  488.         ovl = (Set) pd;
  489.     }
  490.     else {     /* if (ovl != (Set)0) */
  491.         /* this is condition for write, but for read, we call this routine */
  492.          /* iff overloads field is defined     (gs Nov 9 ) */
  493.         n = getnum(ifile, "ovl-set-size");
  494.         ovl = set_new(n);
  495.         for (i = 1; i <= n; i++)
  496.             ovl = set_with(ovl, (char *) getsymref(ifile, "ovl-set-symref"));
  497.     }
  498.     if (nat != na_package || SCOPE_OF(sym) != symbol_standard0)
  499.         /* otherwise the private dcls are inherited from the spec.*/
  500.         OVERLOADS(sym) = ovl;
  501. }
  502.  
  503. static void getsig(IFILE *ifile, Symbol sym, int is_private)        /*;getsig*/
  504. {
  505.     int nat, i, n;
  506.     Tuple    sig, tup, sigtup;
  507.     Node    node;
  508.     Symbol    s, s2;
  509.  
  510.     /* The signature field is used as follows:
  511.      * It is a symbol for:
  512.      *    na_access
  513.      * It is a node for
  514.      *    na_constant  na_in  na_inout
  515.      * It is also a node (always OPT_NODE) for na_out. For now we read this
  516.      * out even though it is not used. 
  517.      * It is a pair for na_array.
  518.      * It is a triple for na_enum.
  519.      * It is a triple for na_generic_function_spec na_generic_procedure_spec
  520.      * The first component is a tuple of pairs, each pair consisting of
  521.      * a symbol and a (default) node.
  522.      * The second component is a tuple of symbols.
  523.      * The third component is a node.
  524.      * It is a tuple with four elements for na_generic_package_spec:
  525.      * the first is a tuple of pairs, with same for as for generic procedure.
  526.      * the second third,and fourth components are nodes.
  527.      *    (see libw.c for format)
  528.      * It is a 5-tuple for na_record.
  529.      * It is a constraint for na_subtype and na_type.
  530.      * It is a node for na_obj.
  531.      * It is a tuple of nodes for na_task_type, na_task_type_spec
  532.      * Otherwise it is the signature for a procedure, namely a tuple
  533.      * of quadruples.
  534.      * In the expand tasks are converted to procedures so their signature is
  535.      * like that of procs.
  536.      */
  537.  
  538.     nat = NATURE(sym);
  539.     /* is_private indicates signature has form of that for record */
  540.     if (is_private) nat=na_record;
  541.  
  542.     switch (nat) {
  543.       case    na_access:
  544.                 /* access: signature is designated_type;*/
  545.                 sig = (Tuple) getsymref(ifile, "sig-access-symref");
  546.                 break;
  547.       case    na_array:
  548. array_case:
  549.                 /* array: signature is pair [i_types, comp_type] where
  550.                  * i_types is tuple of type names
  551.                  */
  552.                 sig = tup_new(2);
  553.                 n = getnum(ifile, "sig-array-itypes-size");
  554.                 tup = tup_new(n);
  555.                 for (i = 1; i <= n; i++)
  556.                     tup[i] = (char *)getsymref(ifile, "sig-array-i-types-type");
  557.                 sig[1] = (char *) tup;
  558.                 sig[2] = (char *) getsymref(ifile, "sig-array-comp-type");
  559.                 break;
  560.       case    na_block:
  561.                 /* block: miscellaneous information */
  562.                 /* This information not needed externally*/
  563.                 chaos("getsig: signature for block");
  564.                 break;
  565.       case    na_constant:
  566.       case    na_in:
  567.       case    na_inout:
  568.       case    na_out:
  569.       case    na_discriminant:
  570.                 sig = (Tuple) getnodref(ifile, "sig-discriminant-nodref");
  571.                 break;
  572.       case    na_entry:
  573.       case    na_entry_family:
  574.       case    na_entry_former:
  575.       /* entry: list of symbols */
  576.       case    na_function:
  577.       case    na_function_spec:
  578.       case    na_literal:
  579.       case    na_op:
  580.       case    na_procedure:
  581.       case    na_procedure_spec:
  582.       case    na_task_body:
  583.                 n = getnum(ifile, "sig-tuple-size");
  584.                 sig = tup_new(n);
  585.                 for (i = 1; i <= n; i++)
  586.                     sig[i] = (char *) getsymref(ifile, "sig-tuple-symref");
  587.                 break;
  588.       case    na_enum:
  589.                 /* enum: tuple in form ['range', lo, hi]*/
  590.                 /* we read this as two node references*/
  591.                 sig = tup_new(3);
  592.                 /*sig[1] = ???;*/
  593.                 sig[2] = (char *) getnodref(ifile, "sig-enum-low-nodref");
  594.                 sig[3] = (char *) getnodref(ifile, "sig-enum-high-nodref");
  595.                 break;
  596.       case    na_type:
  597.                 s  = TYPE_OF(sym);
  598.                 s2 = TYPE_OF(root_type(sym));
  599.                 if ((s != (Symbol)0 && NATURE(s) == na_access) || 
  600.                     (s2 != (Symbol)0 && NATURE(s2) == na_access))  {
  601.                     getsymref(ifile, "sig-access-symref");
  602.                     break;
  603.                 }
  604.                 /* for private types, is_private will be true, and
  605.                 *  signature is that of record 
  606.                  */
  607.                 n = getnum(ifile, "sig-type-size");
  608.                 i = getnum(ifile, "sig-constraint-kind");
  609.                 sig = tup_new(n);
  610.                 sig[1] = (char *) i;
  611.                 for (i=2; i <= n; i++)
  612.                     sig[i] = (char *) getnodref(ifile, "sig-type-nodref");
  613.                 break;
  614.       case na_subtype:
  615.                 n = getnum(ifile, "sig-subtype-size");
  616.                 i = getnum(ifile, "sig-constraint-kind");
  617.                 if (i == CONSTRAINT_ARRAY) goto array_case;
  618.                 sig = tup_new(n);
  619.                 sig[1] = (char *) i;
  620.                 if (i == CONSTRAINT_DISCR) {
  621.                     /* discriminant map */
  622.                     n = getnum(ifile, "sig-constraint-discrmap-size");
  623.                     tup = tup_new(n);
  624.                     for (i = 1; i <= n; i+=2) {
  625.                         tup[i] = (char *)getsymref(ifile,
  626.                           "sig-constraint-discr-map-symref");
  627.                         tup[i+1] = (char *)getnodref(ifile,
  628.                           "sig-constraint-discr-map-nodref");
  629.                     }
  630.                     sig[2] = (char *) tup;
  631.                 }
  632.                 else if (i == CONSTRAINT_ACCESS) {
  633.                     sig[2] = (char *)getsymref(ifile, "sig-subtype-acc-symref");
  634.                 }
  635.                 else {
  636.                     for (i=2; i <= n; i++)
  637.                         sig[i] = (char *)getnodref(ifile, "sig-subtype-nodref");
  638.                 }
  639.                 break;
  640.       case    na_generic_function:
  641.       case    na_generic_procedure:
  642.       case    na_generic_function_spec:
  643.       case    na_generic_procedure_spec:
  644.                 sig = tup_new(4);
  645.                 if (tup_size(sig) != 4) chaos(
  646.                     "getsig: bad signature for na_generic_procedure_spec");
  647.                 /* tuple count known to be four, just put elements */
  648.                 /* the first component is a tuple of pairs, just read count
  649.                  * and the values of the successive pairs 
  650.                  */
  651.                 n = getnum(ifile, "sig-generic-size");
  652.                 sigtup = tup_new(n);
  653.                 for (i = 1;i <= n; i++) {
  654.                     tup = tup_new(2);
  655.                     tup[1] = (char *) getsymref(ifile, "sig-generic-symref");
  656.                     tup[2] = (char *) getnodref(ifile, "sig-generic-nodref");
  657.                     sigtup[i] = (char *) tup;
  658.                 }
  659.                 sig[1] = (char *) sigtup;
  660.                 n = getnum(ifile, "sig-generic-typ-size"); /* symbol list */
  661.                 tup = tup_new(n);
  662.                 for (i = 1;i <= n; i++)
  663.                     tup[i] = (char *) getsymref(ifile,
  664.                       "sig-generic-symbol-symref");
  665.                 sig[2] = (char *) tup;
  666.                 node = getnodref(ifile, "sig-generic-3-nodref");
  667.                 if (nat == na_generic_procedure || nat == na_generic_function)
  668.                     sig[3] = (char *) node;
  669.                 else sig[3] = (char *) OPT_NODE;
  670.                 /* the four component is tuple of must_constrain symbols */
  671.                 n = getnum(ifile, "sig-generic-package-tupsize");
  672.                 tup = tup_new(n);
  673.                 for (i = 1;i <= n; i++)
  674.                     tup[i] = (char *) getsymref(ifile,
  675.                       "sig-generic-package-symref");
  676.                 sig[4] = (char *) tup;
  677.                 break;
  678.       case    na_generic_package_spec:
  679.       case    na_generic_package:
  680.                 /* signature is tuple with four elements */
  681.                 sig = tup_new(5);
  682.                 /* the first component is a tuple of pairs, just write count
  683.                  * and the values of the successive pairs 
  684.                  */
  685.                 n = getnum(ifile, "sig-generic-package-tupsize");
  686.                 tup = tup_new(n);
  687.                 for (i = 1;i <= n; i++) {
  688.                     sigtup = tup_new(2);
  689.                     sigtup[1] = (char *) getsymref(ifile,
  690.                       "sig-generic-package-symref");
  691.                     sigtup[2] = (char *) getnodref(ifile,
  692.                       "sig-generic-package-nodref");
  693.                     tup[i] = (char *) sigtup;
  694.                 }
  695.                 sig[1] = (char *) tup;
  696.                 /* the second third, and fourth components are just nodes */
  697.                 sig[2] = (char *) getnodref(ifile, "sig-generic-node-2");
  698.                 sig[3] = (char *) getnodref(ifile, "sig-generic-node-3");
  699.                 sig[4] = (char *) getnodref(ifile, "sig-generic-node-4");
  700.                 /* the fifth component is tuple of must_constrain symbols */
  701.                 n = getnum(ifile, "sig-generic-package-tupsize");
  702.                 tup = tup_new(n);
  703.                 for (i = 1;i <= n; i++)
  704.                     tup[i] = (char *) getsymref(ifile,
  705.                       "sig-generic-package-symref");
  706.                 sig[5] = (char *) tup;
  707.                 break;
  708.       case    na_record:
  709.                 /* the signature is tuple with five components:
  710.                  * [node, node, tuple of symbols, declaredmap, node]
  711.                  * NOTE: we do not read component count - 5 assumed 
  712.                  */
  713.                 sig = tup_new(5);
  714.                 sig[1] = (char *) getnodref(ifile, "sig-record-1-nodref");
  715.                 sig[2] = (char *) getnodref(ifile, "sig-record-2-nodref");
  716.                 n = getnum(ifile, "sig-record-3-size");
  717.                 tup = tup_new(n);
  718.                 for (i = 1; i <= n; i++)
  719.                     tup[i] = (char *) getsymref(ifile, "sig-record-3-nodref");
  720.                 sig[3]= (char *) tup;
  721.                 sig[4] = (char *) getdcl(ifile);
  722.                 sig[5] = (char *) getnodref(ifile, "sig-record-5-nodref");
  723.                 break;
  724.       case    na_void:
  725.                 /* special case assume entry for $used, in which case is tuple
  726.                  * of symbols
  727.                  */
  728.                 if (streq(ORIG_NAME(sym), "$used") ) {
  729.                     n = getnum(ifile, "sig-$used-size");
  730.                     sig = tup_new(n);
  731.                     for (i = 1; i <= n; i++)
  732.                         sig[i] = (char *) getsymref(ifile, "sig-$used-symref");
  733.                 }
  734.                 else {
  735. #ifdef DEBUG
  736.                     zpsym(sym);
  737. #endif
  738.                     chaos("getsig: na_void, not $used");
  739.                 }
  740.                 break;
  741.       case    na_obj:
  742.                 sig = (Tuple) getnodref(ifile, "sig-obj-nodref");
  743.                 break;
  744.       case    na_task_type:
  745.       case    na_task_type_spec:
  746.                 /* a tuple of nodes */
  747.                 n = getnum(ifile, "task-type-spec-size");
  748.                 sig = tup_new(n);
  749.                 for (i = 1; i <= n; i++)
  750.                     sig[i] = (char *)getnodref(ifile, "sig-task-nodref");
  751.                 break;
  752.     default:
  753. #ifdef DEBUG
  754.                 printf("getsig: default error\n");
  755.                 zpsym(sym);
  756. #endif
  757.                 chaos("getsig: default");
  758.     } /* End of switch */
  759.     SIGNATURE(sym) = sig;
  760. }
  761.  
  762. Symbol getsym(IFILE *ifile, char *desc)                                /*;getsym*/
  763. {
  764.     Symbol    sym, tmp_sym;
  765.     struct f_symbol_s fs;
  766.     int i, nat, is_private;
  767.  
  768.     /* read description for symbol sym to input file */
  769. #ifdef IOT
  770.     if (ifile->fh_trace == 2)
  771.         iot_info(ifile, desc);
  772. #endif
  773. #ifdef HI_LEVEL_IO
  774.     fread((char *) &fs, sizeof(f_symbol_s), 1, ifile->fh_file);
  775. #else
  776.     read(ifile->fh_file, (char *) &fs, sizeof(f_symbol_s));
  777. #endif
  778.     sym = getsymptr(fs.f_symbol_seq, fs.f_symbol_unit);
  779.     nat = fs.f_symbol_nature;
  780.     NATURE(sym) = nat;
  781.     S_SEQ(sym) = fs.f_symbol_seq;
  782.     S_UNIT(sym) = fs.f_symbol_unit;
  783. #ifdef IOT
  784.     if (ifile->fh_trace == 1)
  785.         printf("getsym - reading symbol s%du%d\n", fs.f_symbol_seq,
  786.             fs.f_symbol_unit);
  787.     if (ifile->fh_trace == 2) {
  788.         printf("%d %s =s(%d,%d) type_of(%d,%d)\n",
  789.           fs.f_symbol_nature, nature_str(fs.f_symbol_nature),
  790.           fs.f_symbol_seq, fs.f_symbol_unit, fs.f_symbol_type_of_seq,
  791.           fs.f_symbol_type_of_unit);
  792.         printf(
  793.           "scope_of(%d,%d) sig %d ovl %d dcl %d alias(%d,%d) attr %d misc %d\n",
  794.           fs.f_symbol_scope_of_seq, fs.f_symbol_scope_of_unit,
  795.           fs.f_symbol_signature, fs.f_symbol_overloads,
  796.           fs.f_symbol_declared, fs.f_symbol_alias_seq, fs.f_symbol_alias_unit,
  797.           fs.f_symbol_type_attr,
  798.           fs.f_symbol_misc);
  799.         printf("t_kind %d t_size %d init_proc(%d,%d) assoc %d seg %d off %d\n",
  800.           fs.f_symbol_type_kind, fs.f_symbol_type_size,
  801.           fs.f_symbol_init_proc_seq, fs.f_symbol_init_proc_unit,
  802.           fs.f_symbol_assoc_list,  fs.f_symbol_s_segment, fs.f_symbol_s_offset);
  803.     }
  804. #endif
  805. #ifdef DEBUG
  806.     if (trapss>0 && trapss == fs.f_symbol_seq 
  807.         && trapsu == fs.f_symbol_unit) traps(sym);
  808. #endif
  809.     TYPE_OF(sym) = getsymptr(fs.f_symbol_type_of_seq,
  810.         fs.f_symbol_type_of_unit);
  811.     SCOPE_OF(sym) = getsymptr(fs.f_symbol_scope_of_seq,
  812.         fs.f_symbol_scope_of_unit);
  813.     ALIAS(sym) = getsymptr(fs.f_symbol_alias_seq,
  814.         fs.f_symbol_alias_unit);
  815.     if (fs.f_symbol_type_attr & TA_ISPRIVATE) {
  816.         is_private = TRUE;
  817.         fs.f_symbol_type_attr ^= TA_ISPRIVATE; /* turn off ISPRIVATE bit*/
  818.     }
  819.     else {
  820.         is_private = FALSE;
  821.     }
  822.     TYPE_ATTR(sym) = fs.f_symbol_type_attr;
  823.     ORIG_NAME(sym) = getstr(ifile, "orig-name");
  824.     /* process overloads separately due to variety of cases */
  825.     if (fs.f_symbol_overloads) getovl(ifile, sym);
  826.  
  827.     /* read out declared map, treating na_enum case separately */
  828.     if (fs.f_symbol_declared) DECLARED(sym)= getdcl(ifile);
  829.  
  830.     /* signature */
  831.     if (fs.f_symbol_signature) getsig(ifile, sym, is_private);
  832.  
  833.     /* if procedure or procedure_spec mark to have original name if possible */
  834. #ifdef TBSN
  835.     -- defer
  836.     if (nat == na_subprog || nat == na_procedure_spec)
  837.         TYPE_ATTR(sym) = TYPE_ATTR(sym) | TA_NEEDNAME;
  838. #endif
  839.  
  840.     MISC(sym) = getmisc(ifile, sym, fs.f_symbol_misc);
  841.  
  842.     /* the following fields are extracted for the code generator use only */
  843.     if (TYPE_KIND(sym)  ==  0) TYPE_KIND(sym) = fs.f_symbol_type_kind;
  844.     if (TYPE_SIZE(sym) == 0) TYPE_SIZE(sym) = fs.f_symbol_type_size;
  845.     if (is_type(sym))
  846.         INIT_PROC(sym) = getsymptr(fs.f_symbol_init_proc_seq,
  847.           fs.f_symbol_init_proc_unit);
  848.     else          /* formal_decl_tree for subprogram specs */
  849.         INIT_PROC(sym) = (Symbol) getnodptr(fs.f_symbol_init_proc_seq,
  850.           fs.f_symbol_init_proc_unit);
  851.     if (ASSOCIATED_SYMBOLS(sym) != (Tuple)0) {
  852.         for (i = 1; i<fs.f_symbol_assoc_list; i++) {
  853.             tmp_sym = (Symbol) getsymref(ifile, "assoc-symbol-symref");
  854.             if (tmp_sym != (Symbol)0)
  855.                 ASSOCIATED_SYMBOLS(sym)[i] = (char *) tmp_sym;
  856.         }
  857.     }
  858.     else {
  859.         if (fs.f_symbol_assoc_list == 0)
  860.             ASSOCIATED_SYMBOLS(sym) = (Tuple) 0;
  861.         else 
  862.             ASSOCIATED_SYMBOLS(sym) = tup_new(fs.f_symbol_assoc_list -1);
  863.         if (fs.f_symbol_assoc_list > 1) {
  864.             for (i = 1; i<fs.f_symbol_assoc_list; i++)
  865.                 ASSOCIATED_SYMBOLS(sym)[i] =
  866.                   (char *) getsymref(ifile, "assoc-symbol-symref");
  867.         }
  868.     }
  869.     getrepr(ifile, sym);
  870.     if (S_SEGMENT(sym) == -1) S_SEGMENT(sym) = fs.f_symbol_s_segment;
  871.     if (S_OFFSET(sym) == 0)   S_OFFSET(sym) = fs.f_symbol_s_offset;
  872.     return sym;
  873. }
  874.  
  875.  
  876. Node getnodptr(int seq, int unit)        /*;getnodptr*/
  877. {
  878.     Tuple    nodptr;
  879.     Node    node;
  880.     /* here to convert seq and unit to pointer to symbol.
  881.      * we require that the symbol has already been allocated
  882.      */
  883.     /* TBSL: need to get SEQPTR table for unit, and return address
  884.      */
  885.     if (unit == 0) {
  886.         if (seq == 1) return OPT_NODE;
  887.         if (seq == 0) return (Node)0;
  888.         if (seq>0 && seq <= tup_size(init_nodes)) {
  889.             node = (Node) init_nodes[seq];
  890.             return node;
  891.         }
  892.         else {
  893.             chaos("error for unit 0 in getnodptr");
  894.         }
  895.     }
  896.     if (unit <= unit_numbers) {
  897.         struct unit *pUnit = pUnits[unit];
  898.         nodptr = (Tuple) pUnit->treInfo.tableAllocated;
  899.         if (seq == 0) chaos("getnodptr seq 0");
  900.         if (tup_size(nodptr) != pUnit->treInfo.nodeCount) {
  901.             /* this check is to avoid preallocation of node ptrs for all units
  902.              * in the library.
  903.              */
  904.             tup_free(nodptr);
  905.             nodptr = tup_new(pUnit->treInfo.nodeCount);
  906.             pUnit->treInfo.tableAllocated = (char *)nodptr;
  907.         }
  908.         if (seq <= pUnit->treInfo.nodeCount) {
  909.             node = (Node) nodptr[seq];
  910.             if (node == (Node)0) {/* here to allocate node on first reference */
  911.                 node = node_new_noseq(as_unread);
  912.                 N_SEQ(node) = seq;
  913.                 N_UNIT(node) = unit;
  914.                 nodptr[seq] = (char *) node;
  915.             }
  916.             return node;
  917.         }
  918.     }
  919.     chaos("getnodptr unable to find node");
  920.     return (Node) 0;    /* dummy return for lint's sake */
  921. }
  922.  
  923. Symbol getsymref(IFILE *ifile, char *desc)            /*;getsymref*/
  924. {
  925.     Symbol    sym;
  926.     int seq, unit;
  927. #ifdef IOT
  928.     if (ifile->fh_trace == 2 && (strlen(desc))) printf("%s ", desc);
  929. #endif
  930.     seq = getnum(ifile, "sym-seq");
  931.     unit = getnum(ifile, "sym-unt");
  932.     sym = getsymptr(seq, unit);
  933. #ifdef DEBUG
  934.     if (trapss > 0 && trapss == seq && trapsu == unit) traps(sym);
  935. #endif
  936.     return sym;
  937. }
  938.  
  939. static void getudecl(IFILE *ifile, int ui)                /*;getudecl*/
  940. {
  941.     int i, n, ci, cn;
  942.     Tuple    tup, cent, ctup, cntup, symtup;
  943.     Symbol    usym;
  944.     Unitdecl    ud;
  945.  
  946.     ud = unit_decl_new();
  947.     pUnits[ui]->aisInfo.unitDecl = (char *) ud;
  948.     /* The second entry is the sequence of the symbol table entry
  949.      * identifying the unit. We use this sequence number to find
  950.      * the actual entry alread allocated.
  951.      */
  952. #ifdef TBSN
  953.     /* TBSN: consistency check - dn > 0 and dn<tup_size(syms) */
  954.     dn = getnum(ifile,); /* sequence number of unit symbol*/
  955.     syms = (Tuple) pUnits[ui]->aisInfo.symbols; /* list of allocated symbols */
  956.     if (dn>0 && dn <= tup_size(syms)) {
  957.         ud->ud_unam =  (Symbol) syms[dn];
  958.         ud->ud_useq =  dn;
  959.         /* mark to indicate true name required when write out*/
  960.         sym = (Symbol) syms[dn];
  961.         /*hTYPE_ATTR(sym) = TYPE_ATTR(sym) | TA_NEEDNAME;*/
  962.         NEEDNAME(sym) = TRUE;
  963.     }
  964. #endif
  965.     usym = getsym(ifile, "ud-unam");
  966.     ud->ud_unam = usym;
  967.     ud->ud_useq = S_SEQ(usym);
  968.     ud->ud_unit = S_UNIT(usym);
  969.     /*TYPE_ATTR(usym) = TYPE_ATTR(usym) | TA_NEEDNAME;*/
  970.     NEEDNAME(usym) = TRUE;
  971.     get_unit_unam(ifile, usym);
  972. #ifdef IOT
  973.     if (ifile->fh_trace == 1) printf("udecl %d %s\n", ui, pUnits[ui]->name);
  974.     if (ifile->fh_trace == 1) printf("decl sequence %d\n", ud->ud_useq);
  975. #endif
  976.     /* context */
  977.     n = getnum(ifile, "decl-context-size");
  978.     if (n > 0) {
  979.         n -= 1; /* true tuple size */
  980.         ctup = tup_new(n);
  981. #ifdef IOT
  982.         if (ifile->fh_trace == 1) printf("decl context size %d\n", n);
  983. #endif
  984.         for (i = 1; i <= n; i++) {
  985.             cent = (Tuple) tup_new(2);
  986. #ifdef IOT
  987.             if (ifile->fh_trace == 1) printf("context %d %d\n", i, cent[1]);
  988. #endif
  989.             cent[1] = (char *) getnum(ifile, "decl-ctup-1");
  990.             cn = getnum(ifile, "decl-cntup-size"); 
  991.             cntup = tup_new(cn);
  992.             for (ci = 1; ci <= cn; ci++)
  993.                 cntup[ci] = getstr(ifile, "decl-tupstr-str");
  994.             cent[2] = (char *) cntup;
  995.             ctup[i] = (char *) cent;
  996.         }
  997.         ud->ud_context =  ctup;
  998.     }
  999.     /* unit_nodes */
  1000.     n = getnum(ifile, "decl-ud-nodes-size");
  1001.     tup = tup_new(n);
  1002. #ifdef IOT
  1003.     if (ifile->fh_trace == 1) printf("unit_nodes %d\n", n);
  1004. #endif
  1005.     for (i = 1; i <= n; i++) {
  1006.         tup[i] = (char *) getnodref(ifile, "decl-nodref");
  1007. #ifdef IOT
  1008.         if (ifile->fh_trace == 1) printf("node n%du%d\n",
  1009.             N_SEQ((Node)tup[i]), N_UNIT((Node)tup[i]));
  1010. #endif
  1011.     }
  1012.     ud->ud_nodes = tup;
  1013.     /* tuple of symbol table pointers */
  1014.     n = getnum(ifile, "decl-tuple-size");
  1015.     if (n > 0) {
  1016.         n -= 1; /* true tuple size */
  1017.         tup = tup_new(n);
  1018. #ifdef IOT
  1019.         if (ifile->fh_trace == 1) printf(" decl[5] %d\n", n);
  1020. #endif
  1021.         for (i = 1; i <= n; i++) {
  1022.             tup[i] = (char *) getsym(ifile, "decl-symref");
  1023. #ifdef IOT
  1024.             if (ifile->fh_trace == 1)
  1025.                 printf(" symbol s%du%d\n",
  1026.                     S_SEQ((Symbol)tup[i]), S_UNIT((Symbol)tup[i]));
  1027. #endif
  1028.         }
  1029.         ud->ud_symbols = tup;
  1030.     }
  1031. #ifdef IOT
  1032.     if (ifile->fh_trace == 1) printf(" decscopes %d\n", n);
  1033. #endif
  1034.     /* decscopes - tuple of scopes */
  1035.     n = getnum(ifile, "decl-descopes-tuple-size");
  1036.     if (n > 0) {
  1037.         n -= 1; /* true tuple size */
  1038.         symtup = tup_new(n);
  1039.         for (i = 1; i <= n; i++) {
  1040.             symtup[i] = (char *) getsym(ifile, "decl-decscopes-symref");
  1041. #ifdef IOT
  1042.             if (ifile->fh_trace == 1)
  1043.                 printf(" %d s%du%d\n",
  1044.                     i, S_SEQ((Symbol)symtup[i]), S_UNIT((Symbol)symtup[i]));
  1045. #endif
  1046.         }
  1047.         ud->ud_decscopes =    symtup;
  1048.     }
  1049.     /* decmaps - tuple of declared maps */
  1050. #ifdef IOT
  1051.     if (ifile->fh_trace == 1) printf(" decmaps %d\n", n);
  1052. #endif
  1053.     n = getnum(ifile, "decmaps-tuple-size");
  1054.     if (n > 0) {
  1055.         n -= 1; /* true tuple size */
  1056.         tup = tup_new(n);
  1057.         for (i = 1; i <= n; i++) {
  1058. #ifdef TBSN
  1059.             -- use decl maps read in with symbols    ds 21 dec 
  1060.                 -- but read in anyway for completeness
  1061. #endif
  1062.             tup[i] = (char *) getdcl(ifile);
  1063.             tup[i] = (char *) DECLARED((Symbol)symtup[i]);
  1064.         }
  1065.         ud->ud_decmaps = tup;
  1066.     }
  1067.     /* oldvis - tuple of unit names */
  1068. #ifdef IOT
  1069.     if (ifile->fh_trace == 1) printf(" oldvis %d\n", n);
  1070. #endif
  1071.     n = getnum(ifile, "vis");
  1072.     if (n > 0) {
  1073.         n -= 1; /* true tuple size */
  1074.         tup = tup_new(n);
  1075.         for (i = 1; i <= n; i++) {
  1076.             tup[i] = getstr(ifile, "vis-str");
  1077. #ifdef IOT
  1078.             if (ifile->fh_trace == 1) printf("    %s\n", tup[i]);
  1079. #endif
  1080.         }
  1081.         ud->ud_oldvis = tup;
  1082.     }
  1083.     /* reset NEEDNAME request since read in symbol twice */
  1084.     /*TYPE_ATTR(usym) = TYPE_ATTR(usym) | TA_NEEDNAME;*/
  1085.     NEEDNAME(usym) =TRUE;
  1086.     return;
  1087. }
  1088.  
  1089. char *read_ais(char *fname, int is_aic_file, char *uname,
  1090.   int comp_index, int tree_is_needed)  /*;read_ais*/
  1091. {
  1092.     /* read aic or axq for unit with name uname from file fname.
  1093.      * is_aic_file indicates whether we are reading from an aic or axq file.
  1094.      * if uname is the null pointer, read 'comp_index'th unit from the file.
  1095.      * return TRUE if read ok, FALSE if not. tree_is_needed is a flag to
  1096.      * indicate whether retrieve_tree_nodes needs to be called. Is is always
  1097.      * TRUE for the semantic phase and when called by the expander but is
  1098.      * FALSE when called by BIND in the code generator.
  1099.      */
  1100.  
  1101.     long    rec, genoff;
  1102.     int        indx, fnum, unum, n, nodes, symbols, i, is_main_unit;
  1103.     Tuple    symptr, tup, nodes_group;
  1104.     Set        set;
  1105.     struct unit *pUnit;
  1106.     char    *funame, *retrieved ;
  1107.     Unitdecl    ud;
  1108.     IFILE    *ifile;
  1109.     char    *lname, *tname, *full_fname;
  1110.     int        is_predef; /* set when reading predef file */
  1111.     /* Read information from the current compilation to
  1112.      * 'file', restructuring the separate compilation maps
  1113.      * to improve the readability of the AIS code.
  1114.      */
  1115.  
  1116.     retrieved = NULL;
  1117.     indx = 0;
  1118.     is_predef = streq(fname, "0") && strlen(PREDEFNAME);
  1119.     if (is_predef) {
  1120.         /* reading predef, but not compiling it ! */
  1121.         lname = libset(PREDEFNAME);
  1122.         full_fname = "predef" ;
  1123.     }
  1124.     else {
  1125.         full_fname = fname;
  1126.     }
  1127.     if (is_aic_file)
  1128.         ifile = ifopen(full_fname, "aic", "r", "a", iot_ais_r, 0);
  1129.     else
  1130.         ifile = ifopen(full_fname, "axq", "r", "a", iot_ais_r, 0);
  1131.     if (is_predef)
  1132.         tname = libset(lname); /* restore library name after predef read */
  1133.     for (rec=read_init(ifile); rec != 0; rec=read_next(ifile, rec)) {
  1134.         indx++;
  1135.         funame = getstr(ifile, "unit-name");
  1136.         if (uname == NULL && indx != comp_index) continue;
  1137.         if (uname != NULL  && streq(uname, funame) == 0) continue;
  1138.         fnum = getnum(ifile, "unit-number");
  1139.         unum = unit_number(funame);
  1140.         if (unum != fnum) chaos("read_ais sequence number error");
  1141.         pUnit = pUnits[unum];
  1142.         genoff = getlong(ifile, "code-gen-offset");
  1143.         is_main_unit = streq(unit_name_type(funame), "ma");
  1144.         if (!is_main_unit) { /* read only if NOT main unit (it has no ais info*/
  1145.             symbols = getnum(ifile, "seq-symbol-n");
  1146.             nodes = getnum(ifile, "seq-node-n");
  1147.             /* install tre node info and symbol count in the case where the
  1148.             *  generator reads semantic aisfile and therefore bypasses
  1149.             *  read_lib where the info is normally installed.
  1150.              */
  1151.             if (is_aic_file) {
  1152.                 pUnit->treInfo.nodeCount = nodes;
  1153.                 pUnit->treInfo.tableAllocated = (char *) tup_new(nodes);
  1154.                 pUnit->aisInfo.numberSymbols = symbols;
  1155.                 /* May be old value of aistup[7] may be freed at this point
  1156.                 *  of this is recompilation of unit within the last compilation.
  1157.                  */
  1158.                 pUnit->aisInfo.symbols = (char *) tup_new(symbols);
  1159.                 pUnit->libInfo.fname = AISFILENAME;
  1160.                 pUnit->libInfo.obsolete = string_ok;
  1161.             }
  1162.             symptr = (Tuple) pUnit->aisInfo.symbols;
  1163.             if (symptr == (Tuple)0) { /* if tuple not yet allocated */
  1164.                 symptr = tup_new(symbols);
  1165.                 pUnit->aisInfo.symbols = (char *) symptr;
  1166.             }
  1167.  
  1168.             /* ELABORATE PRAGMA INFO */
  1169.             n = getnum(ifile, "pragma-info-size");
  1170.             tup = tup_new(n);
  1171.             for (i = 1; i <= n; i++)
  1172.                 tup[i] = getstr(ifile, "pragma-info-value");
  1173.             pUnit->aisInfo.pragmaElab = (char *) tup;
  1174.             /* UNIT_DECL */
  1175.             getudecl(ifile, unum);
  1176.             /* PRE_COMP */
  1177.             n = getnum(ifile, "precomp-size");
  1178.             set = (Set) set_new(n);
  1179.             for (i = 1; i <= n; i++)
  1180.                 set = set_with(set, (char *) getnum(ifile, "precomp-value"));
  1181.             pUnit->aisInfo.preComp = (char *) set;
  1182.             /* tuple of symbol table pointers */
  1183.             aisunits_read = tup_with(aisunits_read, funame);
  1184.         }
  1185.         retrieved = funame;
  1186.         break;
  1187.     }
  1188.     if (tree_is_needed && retrieved) {
  1189.         ud = (Unitdecl) pUnit->aisInfo.unitDecl;
  1190.         tup = (Tuple) ud->ud_nodes;
  1191.         n = tup_size(tup);
  1192.         nodes_group = tup_new(n);
  1193.         for (i = 1; i <= n; i++)
  1194.             nodes_group[i] = (char *) N_SEQ((Node)tup[i]);
  1195.         retrieve_tree_nodes(ifile, unum, nodes_group);
  1196.     }
  1197.     ifclose(ifile);
  1198.     return retrieved;
  1199. }
  1200.  
  1201. int read_stub(char *fname, char *uname, char *ext)                /*;read_stub*/
  1202. {
  1203.     long    rec;
  1204.     Stubenv    ev;
  1205.     int        i, j, k, n, m, si;
  1206.     char    *funame;
  1207.     Tuple    stubtup, tup, tup2, tup3;
  1208.     int        ci, cn;
  1209.     int        parent_unit;
  1210.     Tuple    cent, ctup, cntup, nodes_group;
  1211.     Symbol    sym;
  1212.     int        retrieved = FALSE;
  1213.     IFILE    *ifile;
  1214.  
  1215.     /* open so do not fail if no file */
  1216.     ifile = ifopen(fname, ext, "r", "s", iot_ais_r, 1);
  1217.     if (ifile == (IFILE *)0) return retrieved; /* if not stub file */
  1218.     
  1219.     for (rec = read_init(ifile); rec != 0; rec=read_next(ifile, rec)) {
  1220.         funame = getstr(ifile, "stub-name");
  1221.         if (uname != NULL  && !streq(uname, funame)) continue;
  1222.         si = stub_number(funame);
  1223.         if (uname == NULL) lib_stub_put(funame, fname);
  1224.         ev = stubenv_new();
  1225.         stubtup = (Tuple) stub_info[si];
  1226.         stubtup[2] = (char *) ev;
  1227.         n = getnum(ifile, "scope-stack-size");
  1228.         tup = tup_new(n);
  1229.         for (i = 1; i <= n; i++) {
  1230.             tup2 = tup_new(4);
  1231.             tup2[1] = (char *) getsymref(ifile, "scope-stack-symref");
  1232.             for (j = 2; j <= 4; j++) {
  1233.                 m = getnum(ifile, "scope-stack-m");
  1234.                 tup3 = tup_new(m);
  1235.                 for (k=1; k <= m; k++)
  1236.                     tup3[k] = (char *) getsymref(ifile, "scope-stack-m-symref");
  1237.                 tup2[j] = (char *) tup3;
  1238.             }
  1239.             tup[i] = (char *) tup2;
  1240.         }
  1241.         ev->ev_scope_st = tup;
  1242.         ev->ev_unit_unam = getsymref(ifile, "ev-unit-name-symref");
  1243.         ev->ev_decmap = getdcl(ifile);
  1244.  
  1245.         /* unit_nodes */
  1246.         n = getnum(ifile, "ev-nodes-size");
  1247.         tup = tup_new(n);
  1248. #ifdef IOT
  1249.         if (ifile->fh_trace == 1) printf("unit_nodes %d\n", n);
  1250. #endif
  1251.         for (i = 1; i <= n; i++) {
  1252.             tup[i] = (char *) getnodref(ifile, "ev-nodes-nodref");
  1253. #ifdef IOT
  1254.             if (ifile->fh_trace == 1) printf("node n%du%d\n",
  1255.                 N_SEQ((Node)tup[i]), N_UNIT((Node)tup[i]));
  1256. #endif
  1257.         }
  1258.         ev->ev_nodes = tup;
  1259.  
  1260.         /* context */
  1261.         n = getnum(ifile, "stub-context-size");
  1262.         if (n > 0) {
  1263.             n -= 1; /* true tuple size */
  1264.             ctup = tup_new(n);
  1265. #ifdef IOT
  1266.             if (ifile->fh_trace == 1) printf("decl context size %d\n", n);
  1267. #endif
  1268.             for (i = 1; i <= n; i++) {
  1269.                 cent = (Tuple) tup_new(2);
  1270. #ifdef IOT
  1271.                 if (ifile->fh_trace == 1)
  1272.                     printf("context %d %d %s\n", i, cent[1], cent[2]);
  1273. #endif
  1274.                 cent[1] = (char *) getnum(ifile, "stub-cent-1");
  1275.                 cn = getnum(ifile, "stub-cent-2-size"); 
  1276.                 cntup = tup_new(cn);
  1277.                 for (ci = 1; ci <= cn; ci++)
  1278.                     cntup[ci] = getstr(ifile, "stub-cent-2-str");
  1279.                 cent[2] = (char *) cntup;
  1280.                 ctup[i] = (char *) cent;
  1281.             }
  1282.             ev->ev_context =  ctup;
  1283.         }
  1284.         /* tuple of symbol table pointers */
  1285.         /* read in but ignore symbol table references. This is for
  1286.          * read_stub_short so that the generator can rewrite the stubfile
  1287.          * without reading in full symbol table info from semantics phase.
  1288.          */
  1289.         n = getnum(ifile, "ev-decls-refs-size");
  1290.         if (n > 0) {
  1291.             n -= 1; /* true tuple size */
  1292.             for (i = 1; i <= n; i++)
  1293.                 sym = getsymref(ifile, "ev-decls-sym-ref");
  1294.         }
  1295.         /* tuple of symbol table pointers */
  1296.         n = getnum(ifile, "ev-open-decls-size");
  1297.         if (n > 0) {
  1298.             n -= 1; /* true tuple size */
  1299.             tup = tup_new(n);
  1300. #ifdef IOT
  1301.             if (ifile->fh_trace == 1) printf(" decl[5] %d\n", n);
  1302. #endif
  1303.             for (i = 1; i <= n; i++) {
  1304.                 sym = getsym(ifile, "ev-open-decls-sym");
  1305. /*
  1306.     if (NATURE(sym) == na_package || NATURE(sym) == na_procedure) {
  1307.         sym_temp = sym_new_noseq(na_void);
  1308.         sym_copy(sym_temp, sym);
  1309.         tup[i] = (char *) sym_temp;
  1310.     }
  1311.     else {
  1312.         tup[i] = (char *) sym;
  1313.      }
  1314. */
  1315.                 tup[i] = (char *) sym;
  1316. #ifdef IOT
  1317.                 if (ifile->fh_trace == 1)
  1318.                     printf(" symbol s%du%d\n",
  1319.                         S_SEQ((Symbol)tup[i]), S_UNIT((Symbol)tup[i]));
  1320. #endif
  1321.             }
  1322.             ev->ev_open_decls = tup;
  1323.         }
  1324.         ev->ev_current_level = getnum(ifile, "ev-current-level");
  1325.         /* tuple of relay-set symbols */
  1326.         n = getnum(ifile, "ev-relay-set-size");
  1327.         if (n > 0) {
  1328.             n -= 1; /* true tuple size */
  1329.             tup = tup_new(n);
  1330. #ifdef IOT
  1331.             if (iot_ifile == 1) printf(" relay_set %d\n", n);
  1332. #endif
  1333.             for (i = 1; i <= n; i++) {
  1334.                 tup[i] = (char *) getsymref(ifile, "relay-set-sym");
  1335. #ifdef IOT
  1336.                 if (iot_ifile == 1)
  1337.                     printf(" symbol s%du%d\n",
  1338.                         S_SEQ((Symbol)tup[i]), S_UNIT((Symbol)tup[i]));
  1339. #endif
  1340.             }
  1341.             ev->ev_relay_set = tup;
  1342.         }
  1343.         else {
  1344.             ev->ev_relay_set = tup_new(0);
  1345.         }
  1346.         /* tuple of dang-relay-set symbols */
  1347.         n = getnum(ifile, "ev-dang-relay-set-size");
  1348.         if (n > 0) {
  1349.             n -= 1; /* true tuple size */
  1350.             tup = tup_new(n);
  1351. #ifdef IOT
  1352.             if (iot_ifile == 1) printf(" dang-relay-set %d\n", n);
  1353. #endif
  1354.             for (i = 1; i <= n; i++)
  1355.                 tup[i] = (char *) getnum(ifile, "dang-relay-set-ent");
  1356.             ev->ev_dangling_relay_set = tup;
  1357.         }
  1358.         else {
  1359.             ev->ev_dangling_relay_set = tup_new(0);
  1360.         }
  1361.         retrieved = TRUE;
  1362.         if (uname != NULL)  break;
  1363.     }
  1364.     if (retrieved)  {
  1365.         tup = ev->ev_nodes;
  1366.         n = tup_size(tup);
  1367.         nodes_group = tup_new(n);
  1368.         for (i = 1; i <= n; i++)
  1369.             nodes_group[i] = (char *) N_SEQ((Node)tup[i]);
  1370.         parent_unit = stub_parent_get(funame);
  1371.         retrieve_tree_nodes(ifile, parent_unit, nodes_group);
  1372.     }
  1373.     ifclose(ifile);
  1374.     return retrieved;
  1375. }
  1376.  
  1377. int read_lib()                    /*;read_lib*/
  1378. {
  1379.     int        comp_status, si, i, j, n, m, nodes, symbols, cur_level;
  1380.     int        parent, unit_count;
  1381.     Tuple    stubtup, tup;
  1382.     struct unit *pUnit;
  1383.     char    *uname, *aisname, *tmp_str, *parent_name, *compdate;
  1384.     IFILE    *ifile;
  1385.  
  1386.     ifile = LIBFILE;
  1387.     /* note that library file opened by lib_aisname */
  1388.     unit_count = getnum(ifile, "lib-unit-count");
  1389.     n = getnum(ifile, "lib-n");
  1390.     empty_unit_slots = getnum(ifile, "lib-empty-slots");
  1391.     tmp_str = getstr(ifile, "tmp-str");
  1392.     unit_number_expand(n);
  1393.     for (i = 1;i <= unit_count; i++) {
  1394.         uname = getstr(ifile, "lib-unit-name");
  1395.         pUnit = pUnits[getnum(ifile, "lib-unit-number")];
  1396.         aisname = getstr(ifile, "lib-ais-name");
  1397.         compdate = getstr(ifile, "comp-date");
  1398.         symbols = getnum(ifile, "lib-symbols");
  1399.         nodes = getnum(ifile, "lib-nodes");
  1400.         pUnit->name = strjoin(uname, "");
  1401.         pUnit->isMain = getnum(ifile, "lib-is-main");
  1402.         comp_status = getnum(ifile, "lib-status");
  1403.         pUnit->libInfo.fname = strjoin(aisname, "");
  1404.         pUnit->libInfo.obsolete = (comp_status) ? string_ok: string_ds ;
  1405.         pUnit->libUnit = (comp_status) ? strjoin(uname, "") : string_ds;
  1406.         pUnit->aisInfo.numberSymbols = symbols;
  1407.         pUnit->treInfo.nodeCount = nodes;
  1408.         pUnit->treInfo.tableAllocated = (char *) tup_new(0);
  1409. #ifdef IOT
  1410.         if (ifile->fh_trace == 1) printf("read lib %s %d %d\n",
  1411.             pUnit->libInfo.fname, pUnit->aisInfo.numberSymbols,
  1412.             pUnit->treInfo.nodeCount);
  1413. #endif
  1414.     }
  1415.     n = getnum(ifile, "lib-n");
  1416.     for (i = 1;i <= n; i++) {
  1417.         uname = getstr(ifile, "lib-unit-name");
  1418.         aisname = getstr(ifile, "lib-ais-name");
  1419.         lib_stub_put(uname, strjoin(aisname, ""));
  1420.         parent = getnum(ifile, "lib-parent");
  1421.         if (parent == 0) parent_name = " ";
  1422.         else parent_name = pUnits[parent]->name;
  1423.         stub_parent_put(uname, parent_name);
  1424.         cur_level = getnum(ifile, "lib-cur-level");
  1425.         current_level_put(uname, cur_level);
  1426.         /* the following is the associated symbol for a package stub */
  1427.         si = stub_numbered(uname);
  1428.         stubtup = (Tuple) stub_info[si];
  1429.         m = getnum(ifile, "stub-file-size");
  1430.         tup = tup_new(m);
  1431.         for (j = 1;j <= m;j++)
  1432.             tup[j] = (char *) getnum(ifile, "stub-file");
  1433.         stubtup[4] = (char *) tup;
  1434.     }
  1435.     ifclose(LIBFILE);
  1436.     LIBFILE = (IFILE *) 0;
  1437.     return(unit_count);
  1438.  
  1439.     /* read out LIB_STUB map (always empty for now) */
  1440. }
  1441.  
  1442. void load_tre(IFILE *ifile, int comp_index)                        /*;load_tre*/
  1443. {
  1444.     /* load entire tree file. */
  1445.  
  1446.     long    rec, *off;
  1447.     int        i, fnum, unum, n, nodes, rootseq;
  1448.     char    *funame; 
  1449.  
  1450.     i=0;
  1451.     for (rec=read_init(ifile); rec!=0; rec=read_next(ifile, rec)) {
  1452.         i++;
  1453.         if (i != comp_index) continue;
  1454.         funame = getstr(ifile, "unit-name");
  1455.         fnum = getnum(ifile, "unit-number");
  1456.         unum = unit_number(funame);
  1457.         if (unum!=fnum)
  1458.             chaos("load_tre sequence number error");
  1459.         nodes = getnum(ifile, "node-count");
  1460.         /* the rest of the tree info is set in read_ais. Perhaps all can be
  1461.          * done there.
  1462.          */
  1463.         off= (long *)ecalloct((unsigned)nodes+1,sizeof(long),"load-tree-tup-3");
  1464. #ifdef HI_LEVEL_IO
  1465.         fread((char *) off, sizeof(long), nodes+1, ifile->fh_file);
  1466. #else
  1467.         read(ifile->fh_file, (char *) off, sizeof(long)*(nodes+1));
  1468. #endif
  1469.         rootseq = getnum(ifile, "root-seq");
  1470.         pUnits[unum]->treInfo.rootSeq = rootseq;
  1471.         for (n = 1; n <= nodes; n++) {
  1472.             if (off[n] == 0) { /* node not needed */
  1473.                    continue;
  1474.             }
  1475.             else {
  1476.                    ifseek(ifile, "seek-node", off[n], 0);
  1477.                    getnod(ifile, "unit-node", getnodptr(n, unum), unum);
  1478.             }
  1479.         }
  1480.         break;
  1481.     }
  1482.     tup_free((Tuple) off);
  1483.     ifclose(ifile);
  1484. }
  1485.  
  1486. static Tuple add_tree_node(Tuple tup, Node nod)                /*;add_tree_nodes */
  1487. {
  1488.     int        seq;
  1489.  
  1490.     if (nod == (Node)0 || nod == OPT_NODE) return tup;
  1491.     seq = N_SEQ(nod);
  1492.     if (tup_mem((char *) seq, tup)) return tup;
  1493.     tup = tup_with(tup, (char *) seq);
  1494.     return tup;
  1495. }
  1496.  
  1497. static void retrieve_tree_nodes(IFILE *ifile,
  1498.   int node_unit, Tuple nodes_list)   /*;retrieve_tree_nodes*/
  1499. {
  1500.     long    rec, *off;
  1501.     int        unum, items;
  1502.     int        node_seq, nkind;
  1503.     char      *fname;
  1504.     char    *tfname;
  1505.     Node    fn, nd;
  1506.     Fortup    ft1;
  1507.     char    *lname, *tname;
  1508.  
  1509. #ifdef IOT
  1510.     if (ifile != (IFILE *)0  && ifile->fh_trace == 1)
  1511.         printf("retrieve_tree_nodes(a, b, c)\n");
  1512. #endif
  1513.  
  1514.     /* read tree file for unit with unit number "node_unit" and load only
  1515.      * the nodes in nodes_list.
  1516.      */
  1517.  
  1518.     fname = lib_unit_get(pUnits[node_unit]->name);
  1519.     if (streq(fname, "0") && !streq(PREDEFNAME, "")) {
  1520.         /* reading predef, but not compiling it ! */
  1521.         lname = libset(PREDEFNAME);
  1522.         tfname = "predef";
  1523.     }
  1524.     else {
  1525.         tfname = fname;
  1526.     }
  1527.     ifile = ifopen(tfname, "trc", "r", "t", iot_tre_r, 0);
  1528.     if (streq(fname, "0") && !streq(PREDEFNAME, ""))
  1529.         tname= libset(lname); /* restore library name */
  1530.  
  1531.     for (rec=read_init(ifile); rec != 0; rec=read_next(ifile, rec)) {
  1532.         getstr(ifile, "unit_name"); /* skip over unit name */
  1533.         unum = getnum(ifile, "unit-number");
  1534.         if (unum != node_unit) continue;
  1535.         items = getnum(ifile, "node-count");
  1536.         off = (long *) ecalloct((unsigned)items+1, sizeof(long), "read-tree");
  1537. #ifdef HI_LEVEL_IO
  1538.         fread((char *) off, sizeof(long), items+1, ifile->fh_file);
  1539. #else
  1540.         read(ifile->fh_file, (char *) off, sizeof(long)*(items+1));
  1541. #endif
  1542.         break;
  1543.     }
  1544.     while (tup_size(nodes_list)) {
  1545.         node_seq = (int) tup_frome(nodes_list);
  1546.         ifseek(ifile, "seek-node", off[node_seq], 0);
  1547.         fn = getnodptr(node_seq, node_unit);
  1548.         getnod(ifile, "unit-node", fn, unum);
  1549.  
  1550.         nkind = N_KIND(fn);
  1551.         if (N_AST1_DEFINED(nkind) && N_AST1(fn) != (Node)0)
  1552.             nodes_list = add_tree_node(nodes_list, N_AST1(fn));
  1553.         if (N_AST2_DEFINED(nkind) && N_AST2(fn) != (Node)0)
  1554.             nodes_list = add_tree_node(nodes_list, N_AST2(fn));
  1555.         if (N_AST3_DEFINED(nkind) && N_AST3(fn) != (Node)0)
  1556.             nodes_list = add_tree_node(nodes_list, N_AST3(fn));
  1557.         if (N_AST4_DEFINED(nkind) && N_AST4(fn) != (Node)0)
  1558.             nodes_list = add_tree_node(nodes_list, N_AST4(fn));
  1559.  
  1560.         if (N_LIST_DEFINED(N_KIND(fn)) && N_LIST(fn) != (Tuple)0) {
  1561.             FORTUP(nd=(Node), N_LIST(fn), ft1);
  1562.             nodes_list = add_tree_node(nodes_list, nd);
  1563.             ENDFORTUP(ft1);
  1564.         }
  1565.     }
  1566.     tup_free((Tuple) off);
  1567.     tup_free(nodes_list);
  1568.     ifclose(ifile);
  1569. }
  1570.  
  1571. void retrieve_generic_tree(Node node1, Node node2)    /*;retrieve_generic_tree*/
  1572. {
  1573.     Tuple    tup;
  1574.     int        unum;
  1575.  
  1576.     /* Bring in the part of the tree corresponding to a generic package spec
  1577.      * or body, or a generic subprogram body.
  1578.      * When node2 is not 0 it is the case of generic packages and node1
  1579.      * represent the decls_node and node2 represents the priv_node. Otherwise
  1580.      * node1 represents the body_node.
  1581.      */
  1582.     if (N_KIND(node1) ==  as_unread) {
  1583.         tup = tup_new1((char *) N_SEQ(node1));
  1584.     }
  1585.     else {
  1586.         tup = tup_new(0);
  1587.     }
  1588.     if (node2 != (Node)0 && N_KIND(node2) == as_unread) {
  1589.         tup = tup_with(tup, (char *) N_SEQ(node2));
  1590.     }
  1591.     if (tup_size(tup) != 0) {
  1592.         unum = N_UNIT(node1);
  1593.         retrieve_tree_nodes((IFILE *)0, unum, tup);
  1594.     }
  1595. }
  1596.  
  1597. char *lib_aisname()                                        /*;lib_aisname*/
  1598. {
  1599.     int        n, f_num, unit_count;
  1600.     char    *tmp_str, temp_str[4];
  1601.     char    *aisfilename;
  1602.     long    spos;
  1603.     IFILE    *ifile;
  1604.  
  1605.     /* Get name for next ais file from library. The offset within the
  1606.      * library file is not changed.
  1607.      */
  1608.     /* should have last arg nonzero to avoid crash if lib does not exist
  1609.      * and then issue error message
  1610.      */
  1611.  
  1612.     LIBFILE = ifopen(LIBFILENAME, "", "r", "l", iot_lib_r, 0);
  1613.     ifile = LIBFILE;
  1614.     spos = iftell(ifile); /* get current offset in file */
  1615.     unit_count = getnum(ifile, "lib-unit-count");
  1616.     n = getnum(ifile, "lib-n");
  1617.     empty_unit_slots = getnum(ifile, "lib-empty-slots");
  1618.     tmp_str = getstr(ifile, "tmp-str");
  1619.     sscanf(tmp_str, "%d", &f_num);
  1620.     f_num++;
  1621.     sprintf(temp_str, "%d", f_num);
  1622.     aisfilename = strjoin(temp_str, "");
  1623.     /* restore to entry value of file offset */
  1624.     ifseek(ifile, "lib-start", spos, 0);
  1625.     return aisfilename;
  1626. }
  1627.  
  1628. void get_unit_unam(IFILE *ifile, Symbol sym)            /*;get_unit_unam*/
  1629. /*  
  1630.  * reads the full symbol definitions of the associated symbol field of the
  1631.  * unit name symbol. This is needed since when binding is done we want to
  1632.  * load the symbols from this field which represent the procedures to 
  1633.  * elaborate packages.
  1634.  */
  1635. {
  1636.     int    i;
  1637.  
  1638.     for (i = 1;i <= 3; i++)
  1639.         getsym(ifile, "ud-assoc-sym");
  1640. }
  1641.